home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / sun-fns.el < prev    next >
Lisp/Scheme  |  1996-01-20  |  24KB  |  643 lines
  1. ;;; sun-fns.el --- subroutines of Mouse handling for Sun windows
  2.  
  3. ;; Copyright (C) 1987 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Jeff Peck <peck@sun.com>
  6. ;; Keywords: hardware
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; Submitted Mar. 1987, Jeff Peck
  28. ;;              Sun Microsystems Inc. <peck@sun.com>
  29. ;; Conceived Nov. 1986, Stan Jefferson,
  30. ;;                      Computer Science Lab, SRI International.
  31. ;; GoodIdeas Feb. 1987, Steve Greenbaum
  32. ;; & UpClicks           Reasoning Systems, Inc.
  33. ;;
  34. ;;
  35. ;; Functions for manipulating via the mouse and mouse-map definitions
  36. ;; for accessing them.  Also definitions of mouse menus.
  37. ;; This file you should freely modify to reflect you personal tastes.
  38. ;;
  39. ;; First half of file defines functions to implement mouse commands,
  40. ;; Don't delete any of those, just add what ever else you need.
  41. ;; Second half of file defines mouse bindings, do whatever you want there.
  42.  
  43. ;;
  44. ;;         Mouse Functions.
  45. ;;
  46. ;; These functions follow the sun-mouse-handler convention of being called
  47. ;; with three arguments: (window x-pos y-pos)
  48. ;; This makes it easy for a mouse executed command to know where the mouse is.
  49. ;; Use the macro "eval-in-window" to execute a function 
  50. ;; in a temporarily selected window.
  51. ;;
  52. ;; If you have a function that must be called with other arguments
  53. ;; bind the mouse button to an s-exp that contains the necessary parameters.
  54. ;; See "minibuffer" bindings for examples.
  55. ;;
  56.  
  57. ;;; Code:
  58.  
  59. (require 'sun-mouse)
  60.  
  61. (defconst cursor-pause-milliseconds 300
  62.   "*Number of milliseconds to display alternate cursor (usually the mark)")
  63.  
  64. (defun indicate-region (&optional pause)
  65.   "Bounce cursor to mark for cursor-pause-milliseconds and back again"
  66.   (or pause (setq pause cursor-pause-milliseconds))
  67.   (let ((point (point)))
  68.     (goto-char (mark))
  69.     (sit-for-millisecs pause)
  70.     ;(update-display)
  71.     ;(sleep-for-millisecs pause)
  72.     (goto-char point)))
  73.  
  74.  
  75. ;;;
  76. ;;; Text buffer operations
  77. ;;;
  78. (defun mouse-move-point (window x y)
  79.   "Move point to mouse cursor."
  80.   (select-window window)
  81.   (move-to-loc x y)
  82.   (if (memq last-command    ; support the mouse-copy/delete/yank
  83.         '(mouse-copy mouse-delete mouse-yank-move))
  84.       (setq this-command 'mouse-yank-move))
  85.   )
  86.  
  87. (defun mouse-set-mark (window x y)
  88.   "Set mark at mouse cursor."
  89.   (eval-in-window window    ;; use this to get the unwind protect
  90.     (let ((point (point)))
  91.       (move-to-loc x y)
  92.       (set-mark (point))
  93.       (goto-char point)
  94.       (indicate-region)))
  95.   )
  96.  
  97. (defun mouse-set-mark-and-select (window x y)
  98.   "Set mark at mouse cursor, and select that window."
  99.   (select-window window)
  100.   (mouse-set-mark window x y)
  101.   )
  102.  
  103. (defun mouse-set-mark-and-stuff (w x y)
  104.   "Set mark at mouse cursor, and put region in stuff buffer."
  105.   (mouse-set-mark-and-select w x y)
  106.   (sun-select-region (region-beginning) (region-end)))
  107.  
  108. ;;;
  109. ;;; Simple mouse dragging stuff: marking with button up
  110. ;;;
  111.  
  112. (defvar *mouse-drag-window* nil)
  113. (defvar *mouse-drag-x* -1)
  114. (defvar *mouse-drag-y* -1)
  115.  
  116. (defun mouse-drag-move-point (window x y)
  117.   "Move point to mouse cursor, and allow dragging."
  118.   (mouse-move-point window x y)
  119.   (setq *mouse-drag-window* window
  120.     *mouse-drag-x* x
  121.     *mouse-drag-y* y))
  122.  
  123. (defun mouse-drag-set-mark-stuff (window x y)
  124.   "The up click handler that goes with mouse-drag-move-point.
  125. If mouse is in same WINDOW but at different X or Y than when
  126. mouse-drag-move-point was last executed, set the mark at mouse
  127. and put the region in the stuff buffer."
  128.   (if (and (eq *mouse-drag-window* window)
  129.        (not (and (equal *mouse-drag-x* x)
  130.              (equal *mouse-drag-y* y))))
  131.       (mouse-set-mark-and-stuff window x y)
  132.     (setq this-command last-command))    ; this was just an upclick no-op.
  133.   )
  134.  
  135. (defun mouse-select-or-drag-move-point (window x y)
  136.   "Select window if not selected, otherwise do mouse-drag-move-point."
  137.   (if (eq (selected-window) window)
  138.       (mouse-drag-move-point window x y)
  139.     (mouse-select-window window x y)))
  140.  
  141. ;;;
  142. ;;; esoterica:
  143. ;;;
  144. (defun mouse-exch-pt-and-mark (window x y)
  145.   "Exchange point and mark."
  146.   (select-window window)
  147.   (exchange-point-and-mark)
  148.   )
  149.  
  150. (defun mouse-call-kbd-macro (window x y)
  151.   "Invokes last keyboard macro at mouse cursor."
  152.   (mouse-move-point window x y)
  153.   (call-last-kbd-macro)
  154.   )
  155.  
  156. (defun mouse-mark-thing (window x y)
  157.   "Set point and mark to text object using syntax table.
  158. The resulting region is put in the sun-window stuff buffer.
  159. Left or right Paren syntax marks an s-expression.  
  160. Clicking at the end of a line marks the line including a trailing newline.  
  161. If it doesn't recognize one of these it marks the character at point."
  162.   (mouse-move-point window x y)
  163.   (if (eobp) (open-line 1))
  164.   (let* ((char (char-after (point)))
  165.          (syntax (char-syntax char)))
  166.     (cond
  167.      ((eq syntax ?w)            ; word.
  168.       (forward-word 1)
  169.       (set-mark (point))
  170.       (forward-word -1))
  171.      ;; try to include a single following whitespace (is this a good idea?)
  172.      ;; No, not a good idea since inconsistent.
  173.      ;;(if (eq (char-syntax (char-after (mark))) ?\ )
  174.      ;;    (set-mark (1+ (mark))))
  175.      ((eq syntax ?\( )            ; open paren.
  176.       (mark-sexp 1))
  177.      ((eq syntax ?\) )            ; close paren.
  178.       (forward-char 1)
  179.       (mark-sexp -1)
  180.       (exchange-point-and-mark))
  181.      ((eolp)                ; mark line if at end.
  182.       (set-mark (1+ (point)))
  183.       (beginning-of-line 1))
  184.      (t                    ; mark character
  185.       (set-mark (1+ (point)))))
  186.     (indicate-region))            ; display region boundary.
  187.   (sun-select-region (region-beginning) (region-end))
  188.   )
  189.  
  190. (defun mouse-kill-thing (window x y)
  191.   "Kill thing at mouse, and put point there."
  192.   (mouse-mark-thing window x y)
  193.   (kill-region-and-unmark (region-beginning) (region-end))
  194.   )
  195.  
  196. (defun mouse-kill-thing-there (window x y)
  197.   "Kill thing at mouse, leave point where it was.
  198. See mouse-mark-thing for a description of the objects recognized."
  199.   (eval-in-window window 
  200.     (save-excursion
  201.       (mouse-mark-thing window x y)
  202.       (kill-region (region-beginning) (region-end))))
  203.   )
  204.  
  205. (defun mouse-save-thing (window x y &optional quiet)
  206.   "Put thing at mouse in kill ring.
  207. See mouse-mark-thing for a description of the objects recognized."
  208.   (mouse-mark-thing window x y)
  209.   (copy-region-as-kill (region-beginning) (region-end))
  210.   (if (not quiet) (message "Thing saved"))
  211.   )
  212.  
  213. (defun mouse-save-thing-there (window x y &optional quiet)
  214.   "Put thing at mouse in kill ring, leave point as is.
  215. See mouse-mark-thing for a description of the objects recognized."
  216.   (eval-in-window window
  217.     (save-excursion
  218.       (mouse-save-thing window x y quiet))))
  219.  
  220. ;;;
  221. ;;; Mouse yanking...
  222. ;;;
  223. (defun mouse-copy-thing (window x y)
  224.   "Put thing at mouse in kill ring, yank to point.
  225. See mouse-mark-thing for a description of the objects recognized."
  226.   (setq last-command 'not-kill)     ;Avoids appending to previous kills.
  227.   (mouse-save-thing-there window x y t)
  228.   (yank)
  229.   (setq this-command 'yank))
  230.  
  231. (defun mouse-move-thing (window x y)
  232.   "Kill thing at mouse, yank it to point.
  233. See mouse-mark-thing for a description of the objects recognized."
  234.   (setq last-command 'not-kill)     ;Avoids appending to previous kills.
  235.   (mouse-kill-thing-there window x y)
  236.   (yank)
  237.   (setq this-command 'yank))
  238.  
  239. (defun mouse-yank-at-point (&optional window x y)
  240.   "Yank fro